Attribute VB_Name = "modSubClass"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     DbgWProc.dll (Debug Object for AddressOf Subclassing) (debugging only)
'   Files:
'     PushParamThunk.bas
'   Minimal VBoost conditionals:
'     None
'   Conditional Compilation Values:
'     DEBUGWINDOWPROC = 1 'Enable IDE debugging with the subclass enabled
'
' This file is discussed in Chapter 16.
'***************************************************************
Option Explicit

'Declares for SetWindowLong and GWL_WNDPROC are assumed, or you can uncomment these.
'Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'Public Const GWL_WNDPROC As Long = -4
Public Type SubClassData
    wndprocNext As Long
    wndprocThunk As PushParamThunk
    #If DEBUGWINDOWPROC Then
    dbg_Hook As WindowProcHook
    #End If
End Type

Public Sub SubClass(Data As SubClassData, ByVal hWnd As Long, ByVal ThisPtr As Long, ByVal pfnRedirect As Long)
    With Data
        If .wndprocNext Then
            SetWindowLong hWnd, GWL_WNDPROC, .wndprocNext
            .wndprocNext = 0
        End If
        InitPushParamThunk .wndprocThunk, ThisPtr, pfnRedirect
#If DEBUGWINDOWPROC Then
        On Error Resume Next
        Set .dbg_Hook = Nothing
        Set .dbg_Hook = CreateWindowProcHook
        If Err Then Exit Sub
        On Error GoTo 0
        With .dbg_Hook
            .SetMainProc Data.wndprocThunk.pfn
            Data.wndprocNext = SetWindowLong(hWnd, GWL_WNDPROC, .ProcAddress)
            .SetDebugProc Data.wndprocNext
        End With
#Else
        .wndprocNext = SetWindowLong(hWnd, GWL_WNDPROC, .wndprocThunk.pfn)
#End If
    End With
End Sub
Public Sub UnSubClass(Data As SubClassData, ByVal hWnd As Long)
    With Data
        If .wndprocNext Then
            SetWindowLong hWnd, GWL_WNDPROC, .wndprocNext
            .wndprocNext = 0
        End If
#If DEBUGWINDOWPROC Then
        Set .dbg_Hook = Nothing
#End If
    End With
End Sub


